home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / assemblr / library / sampler0 / soundexa.asm < prev    next >
Assembly Source File  |  1988-03-28  |  15KB  |  281 lines
  1. TITLE SOUNDEXA
  2. PAGE ,132
  3.  
  4. ;Author : bp-programs, Kalamazoo, Michigan
  5. ;Date: Jan 88, for Clipper Summer 87
  6. ;Source Code protected by United States Copyright Law
  7. ;Permission given for code to be incorporated in other programs by author
  8.  
  9. ;Syntax: SOUNDEXA(string[,filler])
  10.  
  11. ;The soundex code is useful to look up names where you aren't sure of the
  12. ;spelling.  Codes for similar sounding names are generally (but NOT always)
  13. ;close together. The code has the format LETTER-DIGIT-DIGIT-DIGIT. LETTER is
  14. ;simply the upper case first letter of the name. DIGITs are derived from the
  15. ;translation table below.  Empty positions are NOT translated.  If there are
  16. ;two or more letters with the same code following each other in the name, only
  17. ;ONE code number is used. 'Schmidt' is 'S530', not 'S253' or 'S533'. If there
  18. ;are more than three code numbers, the extra ones aren't used.  If there are
  19. ;fewer, the code is padded with zeros. (But see about FILLER below).
  20.  
  21. ;Soundex               ABCDEFGHIJKLMNOPQRSTUVWXYZ
  22. ;Translation Table:     123 12  22455 12623 1 2 2
  23.  
  24. ;SOUNDEXA is an assembly language implementation of the soundex code.  It
  25. ;follows my interpretation of the algorithm found on pages 392/393 of Knuth's
  26. ;book 'Sorting and Searching', volume 3 of "The Art of Computer Programming".
  27.  
  28. ;It does NOT return the same code as the soundex routine in examplec.c
  29. ;(SOUNDEXC) distributed with Clipper Summer 87 or the Rettig soundex routine
  30. ;distributed with Clipper Autumn 86 in extenddb.prg (SOUNDEXD).
  31. ;The main differences among the three implementations are listed below.
  32.  
  33. ;           SOUNDEXA                 SOUNDEXC               SOUNDEXD
  34. ;           ----------------------   ---------------------  ----------------
  35. ;Format     A999                     A999                   A9999
  36.  
  37. ;Dupes      Skips ltrs generating    Skips identical ltrs   Skips duplicate
  38. ;           the same code which are  adjacent in original   code numbers even
  39. ;           immediately adjacent in  text                   if not adjacent in
  40. ;           original text                                   original text
  41.  
  42. ;Null       1. Null string           1. Null string         1. Null string
  43. ;Returns    2. Completely non-alpha  2. Non-alpha/non
  44. ;              string                   space characters
  45. ;                                       except first char
  46.  
  47. ;Fault      1. Ltrims leading non-   1. Does not trim, uses 1. Does not trim,
  48. ;Tolerance     alpha characters         non-alpha as lead      uses any char
  49. ;           2. Skips intermediate    2. Aborts with non-    2. Skips inter-
  50. ;              non-alpha characters     alpha/non-space        mediate non-
  51. ;                                       except first char      alpha chars
  52.  
  53. ;Speed      3 secs/5000 repeats      9 secs/5000 repeats    90 secs/5000 repts
  54. ;I believe, of course, that SOUNDEXA is the 'best' implementation because
  55. ;it's closest to Knuth's algorithm, most fault tolerant, fastest (and also
  56. ;smallest, by the way) and the most FLEXIBLE.  More about this below.
  57.  
  58. ;Knuth's algorithm uses 0s (character zero) to fill trailing empty slots.
  59. ;This makes sense when you're constructing an index, such as
  60.  
  61. ;       INDEX ON SOUNDEXA(LASTNAME) TO NAMX
  62.  
  63. ;However, when you're SEEK/LOCATEing with SOUNDEX you generally want to find
  64. ;all likely candidates and want to make sure that you don't miss any.  You'd
  65. ;rather find a few wrong ones than miss a single right one. In that case
  66. ;you want to include even partial matches, such as
  67.  
  68. ;       LOCATE ALL FOR TRIM(SOUNDEXA(PART_NAME))
  69.  
  70. ;SOUNDEXA allows you to select between two fillers, spaces or '0'.  Even
  71. ;though zeros are 'standard', I find spaces more flexible and have made them
  72. ;the default. By specifying a second argument SOUNDEXA(LASTNAME,FILLER) once,
  73. ;you change the state of the routine.  If FILLER is a '0' (as a character, not
  74. ;a number), all future calls to SOUNDEXA will use zeros for filling.  If
  75. ;FILLER is any other character (or even a null string), SOUNDEXA will use
  76. ;spaces in the future.  If there isn't a second argument, SOUNDEXA will use
  77. ;what you specified before or the default. If you prefer zeros as the default,
  78. ;change the FILLER DB to '0' in the DATASG.
  79.  
  80.  
  81. ;===================================================
  82. EXTRN   __PARINFO:FAR  ;Clipper EXTEND routine, tells how many arguments
  83. EXTRN   __PARC:FAR     ;Clipper EXTEND routine, gets a character argument
  84. EXTRN   __RETC:FAR     ;Clipper EXTEND routine, returns a character value
  85.  
  86. SX_LENGTH       EQU    4     ;Length of soundex code
  87.  
  88. DGROUP  GROUP   DATASG       ;Ties this segment to the other data segments
  89.                              ;of Clipper.  DS points to this DGROUP when
  90.                              ;we arrive in the assembly routine
  91.  
  92. DATASG SEGMENT WORD PUBLIC 'DATA'  ;All PUBLIC segments with the name DATASG
  93.                              ;will be combined by the linker.  All segments
  94.                              ;with the class 'DATA' will be adjacent to
  95.                              ;each other. WORD means that the segment
  96.                              ;starts on an even byte, which can sometimes
  97.                              ;be minutely faster in an 8086/80286 machine.
  98.  
  99. SOUNDEX      DB   SX_LENGTH DUP (?)        ; Space for SOUNDEX result
  100.              DB 00                         ; Terminator byte
  101.              ;Strings in C and Clipper are terminated by a NULL (or NUL or
  102.              ;NIL, it all means the same thing).  There is no length byte
  103.              ;or word as in BASIC or Turbo Pascal.
  104. FILLER       DB ' '          ; Filler byte for padding of SOUNDEX, can be
  105.                              ; space (default) or '0'
  106.                 ; Translate table from UC letters to SOUNDEX codes
  107.                 ; Omitted letters return NULL
  108. ;               'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
  109. ;               ' 123 12  22455 12623 1 2 2'
  110. TRANSLATE       db 0,'123',0,'12',0,0,'22455',0,'12623',0,'1',0,'2',0,'2'
  111.  
  112. DATASG  ENDS
  113. ;==================================================
  114.  
  115.  
  116. ;==================================================
  117. _PROG   SEGMENT   BYTE PUBLIC 'CODE'      ;All PUBLIC segments with
  118.                                           ;the name _PROG will be com-
  119.                                           ;bined, all segments with the
  120.                                           ;class 'CODE' will be
  121.                                           ;adjacent.  BYTE means that
  122.                                           ;the segments will be aligned
  123.                                           ;(stuck together) without any
  124.                                           ;padding.
  125.  
  126. ASSUME  CS:_PROG, DS:DGROUP, ES:NOTHING   ;This is the way the segment
  127.                                           ;registers are set up when we
  128.                                           ;arrive here from Clipper.
  129. PUBLIC  SOUNDEXA        ;Used in linking to Clipper, lets Clipper know
  130.                         ;where this routine is.
  131.  
  132. SOUNDEXA     PROC FAR   ;The name of our routine (procedure)
  133.  
  134.              PUSH BP         ;The Clipper extend documentation on disk
  135.              PUSH DI         ;says that we have to save registers
  136.              PUSH SI         ;BP, DI, SI, ES and DS.  We are not
  137.              PUSH ES         ;disturbing BP, so we may not have to save it.
  138.              PUSH DS         ;But the Clipper routines __PARINFO, __PARC
  139.                              ;and __RETC may do so, we don't know.
  140.  
  141.              ;Ensure null string in case of missing argument or no letters
  142.              ;We do this by moving a NULL byte in the first place of the
  143.              ;SOUNDEX code.  It will be overwritten if there's no error.
  144.              MOV BYTE PTR DGROUP:[SOUNDEX], 0
  145.  
  146.              SUB AX, AX      ;Faster and smaller than MOV AX, 0
  147.              PUSH AX
  148.              CALL __PARINFO  ;Find out how many arguments passed
  149.              ADD SP, 2       ;Clean up stack. C routines, unlike BASIC
  150.                                 ;or Pascal do NOT clean up the stack.
  151.              CMP AX, 1       ;Is there 1 argument?
  152.              JE MAIN_ROUT    ;Yes, use stored filler for conversion
  153.  
  154.              CMP AX, 2       ;Are there two arguments?
  155.              JNE LEAVE       ;No, an invalid number of arguments. Leave.
  156.              ;Two arguments, get the second one - a new FILLER
  157.              PUSH AX         ;AX is always 2 here
  158.              CALL __PARC     ;Get the address of FILLER string
  159.              ADD SP, 2       ;DX:AX hold pointer to string
  160.              MOV ES, DX
  161.              MOV BX, AX      ;Use ES:BX to point to FILLER string
  162.              MOV AL, ' '     ;Load default space character
  163.              CMP BYTE PTR ES:[BX], '0'        ;Is the new FILLER a '0'?
  164.              JNE SX010               ;No, all set with space
  165.              MOV AL, '0'             ;Yes, make it a '0'
  166. SX010:       MOV DGROUP:FILLER, AL   ;Set Filler character
  167.              MOV AX, 1
  168.  
  169.              ;AX is always 1 here, either set above or CMP AX, 1
  170.              ;Pointer to string in DX:AX (SEG:OFS) for Clipper S87
  171. MAIN_ROUT:   PUSH AX
  172.              CALL __PARC     ;Get pointer to string to convert
  173.              ADD SP, 2       ;Pointer to string returned in DX:AX (SEG:OFS)
  174.              ;Set up pointer registers, seg and ofs
  175.              ;DS:SI - String to convert, pointer incrementing
  176.              ;ES:DI - SOUNDEX code in DGROUP, pointer incrementing
  177.              ;ES:BX - TRANSLATE in DGROUP, points always to base
  178.              PUSH DS
  179.              POP ES          ;ES now points to DGROUP
  180.              MOV DS, DX      ;And DS to where ever Clipper stores
  181.                              ;its string arguments.
  182.              MOV SI, AX      ;DS:SI point to start of string to convert
  183.  
  184.              MOV DI, OFFSET DGROUP:SOUNDEX ;ES:DI point to start of
  185.                                            ;SOUNDEX
  186.              MOV BX, OFFSET DGROUP:TRANSLATE ;ES:BX point to TRANSLATE base
  187.              CLD             ;Work upward in string instructions
  188.  
  189.              ASSUME DS:NOTHING, ES:DGROUP
  190.              ;Let MASM know that we've switched seg regs around
  191.              MOV CX, SX_LENGTH   ;Maximum SOUNDEX length
  192.  
  193. FIRST_LTR:   LODSB           ;Get start byte from string to convert
  194.              OR AL, AL       ;At end of string to convert?
  195.              JZ LEAVE        ;NULL string or no letters anywhere in
  196.                              ;string, return a NULL string
  197.              ; Real chararacter here, but is it a letter?
  198.              AND AL, 0DFH    ;This converts letters to upper case,
  199.                              ;destroys other characters.  But since
  200.                              ;we don't care about those, it's ok.
  201.              MOV AH, AL      ;Save the possible starting letter
  202.              SUB AL, 'A'     ;Subtract the ASCII value of A which
  203.                              ;is 65. This makes A 0, B 1, C 2 etc.
  204.              JS FIRST_LTR    ;Negative, so not a letter, try again
  205.              CMP AL, 'Z' - 'A'       ;ASCII Z minus ASCII A is the largest
  206.                                      ;real letter value.
  207.              JA FIRST_LTR            ;Not a letter either, try again
  208.              ;We found a valid UC starting letter. It's both in AH and AL
  209.              XLAT DGROUP:TRANSLATE   ;Convert to SOUNDEX code 1-6 or NULL
  210.                                      ;XLAT adds the value in AL to BX and
  211.                                      ;fetches the character pointed to by
  212.                                      ;(normally) DS:BX+AL.  Since in this
  213.                                      ;case DS points the NOTHING and ES to
  214.                                      ;DGROUP, MASM is smart enough to make
  215.                                      ;a segment override so that XLAT gets
  216.                                      ;the byte at ES:BX+AL and puts it in
  217.                                      ;AL. (Replacing the original pointer)
  218.  
  219.              XCHG AH, AL     ;After switch, AH holds code,
  220.                              ;AL the UC starting letter
  221.              STOSB           ;Put first letter into SOUNDEX
  222.              LOOP DIGITS     ;Decrement CX and jump to actual
  223.                              ;digit conversion. Skip over one
  224.                              ;piece of code.
  225.  
  226. ERR_DIGITS:  SUB AH, AH      ;Jump to here only when looping back
  227.                              ;and we want to clear out false
  228.                              ;'previous' letter matches if
  229.                              ;there are non-letters in between.
  230.  
  231. DIGITS:      LODSB           ;Get the next character
  232.              OR AL, AL       ;ORing a value is the fastest way to
  233.                              ;find out if it's NULL (end of string)
  234.              JZ ALL_DONE     ;Trailing NULL detected
  235.              ;Not at end of string to convert
  236.              AND AL, 0DFH    ;Convert to UC
  237.              SUB AL, 'A'     ;Subtract ASCII 'A'
  238.              JS ERR_DIGITS   ;Negative, not a letter
  239.                              ;Clear out previous code in AH
  240.              CMP AL, 'Z' - 'A'
  241.              JA ERR_DIGITS   ;Not a letter either, clear previous
  242.                              ;code in AH
  243.              ;Valid UC letter in AL, 'previous' code in AH
  244.              XLAT DGROUP:TRANSLATE   ;Convert to SOUNDEX code or NULL
  245.              CMP AH, AL      ;Same code as previous letter?
  246.              JE DIGITS       ;Yes, duplicate, don't add to SOUNDEX
  247.              ;New code, not a duplicate
  248.              MOV AH, AL      ;Save it as the new 'previous' code
  249.              OR AL, AL       ;Is it a real or a null code?
  250.              JZ DIGITS       ;Null code, don't add to SOUNDEX
  251.  
  252.              ;Valid code in AL, not the same as previous, add to SOUNDEX
  253.              STOSB
  254.              LOOP DIGITS     ;Continue until SX_LENGTH in SOUNDEX
  255.  
  256.  
  257. ALL_DONE:    JCXZ LEAVE      ;Complete soundex, CX counted down
  258.              MOV AL, DGROUP:[FILLER] ; ' ' or '0'
  259.              REP STOSB       ;Fill remainder of SOUNDEX with FILLER
  260.  
  261. LEAVE:       POP DS          ;Restore DGROUP segment into DS
  262.                              ;Clipper routines, such as __RETC
  263.                              ;expect DS to be pointing to DGROUP
  264.  
  265.              PUSH DS         ;Push segment of SOUNDEX string
  266.              MOV AX, OFFSET DGROUP:SOUNDEX
  267.              PUSH AX         ;And push the offset of SOUNDEX
  268.              CALL __RETC     ;Return pointer to SOUNDEX to Clipper
  269.              ADD SP, 4       ;Clean up stack
  270.  
  271.              ;DS already popped above
  272.              POP ES          ;Get remainder of saved registers back
  273.              POP SI
  274.              POP DI
  275.              POP BP
  276.              RET             ;Go back to Clipper
  277.  
  278. SOUNDEXA     ENDP
  279. _PROG        ENDS
  280.              END
  281.